perm filename FILZ.F4[TMP,LCS] blob
sn#136271 filedate 1974-12-17 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE FILLER(Q,R,NE,M,LP,IT,LD,LS)
C00007 ENDMK
Cā;
SUBROUTINE FILLER(Q,R,NE,M,LP,IT,LD,LS)
DIMENSION Q(1),R(1),NE(1)
KK=NE(1)
KJ=2
DO 4 K=2,KK
IF(NE(K).NE.3)GO TO 11
NE(K)=-1
KJ=K+1
GO TO 4
11 NE(K)=0
4 CONTINUE
RLFT=10000
RT=-10000
B=RT
DO 12 K=1,KK
H=IFIX(Q(K))
IF(H.LT.RLFT)RLFT=H
IF(H.GT.RT)RT=H
IF(H.EQ.B)NE(K)=-1
B=H
Q(K)=H
12 R(K)=IFIX(R(K))
NE(KK+1)=-1
LRT=RT
JA=3
124 LEFT=RLFT
51 J=LEFT
42 RJ=J+.001
JCONT=0
CC JN=J
LEFT=J
JJ=-1
ALT=-10000.
200 DO 45 L=2,KK
IF(NE(L).NE.0)GO TO 45
IF(MISS(L,RJ,Q))GO TO 45
H=HGHT(L,RJ,Q,R)
IF(H.LT.ALT)GO TO 45
ALT=H
JJ=L
45 CONTINUE
IF(JJ)GO TO 43
JCONT=-1
LEFT=J
46 JA=3
JORD=-1
52 KN=Q(JJ)
KL=Q(JJ-1)
IF(KN.LT.KL)KN=KL
50 I=J
102 RJ=I+.01
ALT=HGHT(JJ,RJ,Q,R)
B=-10000
JK=-1
XALT=ALT+.001
ZALT=ALT
400 DO 47 L=2,KK
IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
H=HGHT(L,RJ,Q,R)
IF(H.GT.XALT)GO TO 47
IF(H.LE.B)GO TO 47
B=H
JK=L
47 CONTINUE
IF(JK)GO TO 48
ALT=ALT-1
300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
JX=Q(JK)
IF(JX.GT.KN)GO TO 60
JX=Q(JK-1)
IF(JX.LT.KN)GO TO 59
60 L=JJ
JJ=JK
JK=L
KN=JX
59 B=B+1
IF(JORD)GO TO 103
H=B
B=ALT
ALT=H
IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
103 CALL LINES(RJ,ALT,JA,LP,IT,LS,LD)
100 I2=2
CALL LINES(RJ,B,I2,LP,IT,LS,LD)
NK=JK
JORD=-JORD
NE(JK)=1
NE(JJ)=-1
JA=2
I=I+M
IF(I.LT.KN)GO TO 102
L=1
IF(KN.EQ.KL)L=-1
JJ=JJ+L
J=0
IF(L)J=-1
IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
J=I
GO TO 52
48 JA=3
43 J=LEFT+M
IF(J.LE.LRT)GO TO 42
IF(JCONT)GO TO 51
END
FUNCTION HGHT(J,A,Q,R)
DIMENSION Q(1),R(1)
B=R(J-1)
D=Q(J-1)
F=Q(J)
HGHT=((R(J)-B)*(A-D))/(F-D)+B
IF(F.EQ.D)HGHT=B
END
FUNCTION MISS(J,A,Q)
DIMENSION Q(1)
B=Q(J)
C=Q(J-1)
MISS=-1
IF((A.LT.C.AND.A.GT.B).OR.(A.LT.B.AND.A.GT.C))MISS=0
END